1000 GOSUB 5840 'cs
1010 PRINT:PRINT TAB(29);"DPUT - March 20, 1982
1015 ' by Dan Dugan -- public domain
1020 PRINT
1030 DEFINT A-Z
1040 COMMON I,J,K,X,Y,T$,R$,S$,T1$,SKIPPARSE,FT,SEARCH,

	C,N,NC,P6,P7,P8,P9,PI,S,T,T1,T2,C(),B$(),N$(),

	SEARCHWORD$(),SEARCHFIELD(),SKIPWORD$(),LOOKFIELD(),DD$(),F$,FT$
1060 '


				OPEN OUTPUT FILE


1070 PRINT:INPUT"Name of destination file";X$
1080 GOSUB 5950			'ucv
1085 F2$=Y$
1090 '		DISK NAME


1100 IF MID$(F2$,2,1)=":" THEN 1120
1110 F2$=DD$(5)+F2$
1120 '

		TEST FOR EXISTENCE


1130 ON ERROR GOTO 1160
1140	OPEN"I",3,F2$
1150	CLOSE 3:ON ERROR GOTO 0
1152	PRINT:PRINT F2$" exists already.  Use a different name.":GOTO 1060
1160 CLOSE 3
1170 IF ERR=53 THEN RESUME 1210	'not found
1180 IF ERR=61 THEN PRINT:PRINT"Sorry, disk full.":RESUME 5650 'exit
1190 IF ERR=64 THEN PRINT"Bad file name, try again.":RESUME 1060
1195 IF ERR=67 THEN PRINT:PRINT"Out of directory space.":RESUME 5650
1200 ON ERROR GOTO 0
1210 '


		OPEN NEW FILE


1220 OPEN"O",3,F2$
1230 NR=0
5000 '




				RECORD WORK LOOP


5030 '
5040 FOR I=T1 TO T2 '		<==== FOR
5050 GOSUB 5870 ' get rec
5060 IF ASC(T$)=0 THEN PRINT"0";:GOTO 5630
5070 PRINT"+";
5080 T1$=T$ ' save it
5090 IF SKIPPARSE=1 THEN 5110
5100 GOSUB 5700 ' parse record string
5110 IF SEARCH=0 THEN 5500
5120 '



				SEARCH


5130 IF SEARCH<>2 THEN 5180
5135 '


		FIND


5140 IF INSTR(T$,SEARCHWORD$(0))=0 THEN 5630
5160 GOSUB 5700 ' parse
5170 GOTO 5500
5180 '


		FIELD SEARCH


5190 J=0 '			check for skips first
5200 IF SKIPWORD$(J)="" THEN 5280 ' try search then
5210 IF LOOKFIELD(J)<>0 THEN 5250 ' look in field
5220 IF INSTR(T1$,SKIPWORD$(J))<>0 THEN 5630 ' whole rec search - skip it
5230 J=J+1
5240 GOTO 5200
5250 IF INSTR(B$(LOOKFIELD(J)),SKIPWORD$(J))<>0 THEN 5630 ' field compare - skip
5260 J=J+1
5270 GOTO 5200
5280 IF SEARCHWORD$(0)="" THEN 5380 ' don't care so print it
5290 J=0: GOTO 5310 '		now search
5300 IF SEARCHWORD$(J)="" THEN 5630 ' hesitate no longer
5310 IF SEARCHFIELD(J)<>0 THEN 5350 ' field
5320 IF INSTR(T1$,SEARCHWORD$(J))<>0 THEN 5380 ' found it
5330 J=J+1
5340 GOTO 5300
5350 IF INSTR(B$(SEARCHFIELD(J)),SEARCHWORD$(J))<>0 THEN 5380
5360 J=J+1
5370 GOTO 5300
5380 '


		GET READY TO DO IT


5390 IF SKIPPARSE=1 THEN GOSUB 5700 ' parse
5500 '


				DO WORK


5510 PRINT CHR$(40);I;CHR$(41)
5520 FOR J=1 TO NC
5530	IF C(J)=0 THEN 5610
5540 '		Substitute "~" for quote chars.
5550	QUOTE=INSTR(B$(J),CHR$(34))
5560	IF QUOTE THEN MID$(B$(J),QUOTE,1)=CHR$(126):GOTO 5550
5570 '		Put quotes around strings with commas in 'em
5580	IF INSTR(B$(J),CHR$(44)) THEN B$(J)=CHR$(34)+B$(J)+CHR$(34)
5590	IF J>1 THEN PRINT#3,CHR$(44);:PRINT CHR$(44);
5600	PRINT#3,B$(J);:PRINT B$(J);
5610 NEXT
5620 PRINT#3,:PRINT:NR=NR+1
5630	GOSUB 5790 ' check exit
5640 NEXT I '			END OF RECORD WORK LOOP
5650 '


				FINISH


5660 CLOSE 3
5670 PRINT:PRINT NR"records.
5680 PRINT:PRINT TAB(32)"Re-loading DEDIT.
5690 CHAIN DD$(1)+"DEDIT",1000
5700 '




				PARSE STRING


5710 K=0
5720 M=INSTR(T$,CHR$(126)) ' delimiter
5730 IF M=0 THEN RETURN
5740 K=K+1
5750 B$(K)=""
5760 B$(K)=MID$(T$,1,M-1)
5770 T$=MID$(T$,M+1)
5780 GOTO 5720
5790 '



				(SUB) EXIT TEST


5800 X$=INKEY$:X=0
5810 IF X$<>"" THEN X=ASC(X$)
5820 IF X=27 THEN CLOSE 3:GOTO 5650	'use ESC to escape process
5830 RETURN
5840 '



				(SUB) CLEAR SCREEN (TERM DEP)


5850 PRINT CHR$(12);
5860 RETURN
5870 '



				(SUB) GET RECORD "I" IN T$


5880 T$="" ' necessary!
5890 ON FT GOTO 5920,5900
5900	GET#1,FT*I+2 ' latter half
5910	T$=LEFT$(R$,127)
5920	GET#1,FT*I+1 ' whole or first half
5930	T$=R$+T$
5940 RETURN
5950 '


				(SUB) UCV


5960 Y$=""
5970 FOR K=1 TO LEN(X$)
5980	Y$=Y$+CHR$(32)
5990	X=ASC(MID$(X$,K,1))
6000	IF 96<X AND X<123 THEN MID$(Y$,K,1)=CHR$(X-32):GOTO 6020
6010	MID$(Y$,K,1)=MID$(X$,K,1)
6020 NEXT
6030 RETURN
